home *** CD-ROM | disk | FTP | other *** search
/ Delphi Developer's Kit 1996 / Delphi Developer's Kit 1996.iso / power / handles / handles.pas < prev    next >
Pascal/Delphi Source File  |  1995-12-22  |  25KB  |  771 lines
  1. unit Handles;
  2.  
  3. { A first attempt at a StretchHandle component for Delphi... it "owns"
  4.   another component via the FChildControl property, and will resize or
  5.   move its Child along with itself when it is dragged or stretched at
  6.   runtime with the left mouse button. The component is sized 2 pixels
  7.   larger on each side than its FChildControl, and the grab handles are
  8.   5x5.  It will shrink to 5x5.
  9.  
  10.   Any suggestions for improvement would be appreciated...
  11.  
  12.   Revised 7/1/95: Used MouseUp, MouseDown, MouseMove override rather than
  13.                   message handlers for mouse events.
  14.  
  15.                   Changed name of EControlInvalid to EBadChild (sorry!).
  16.  
  17.                   Added Child property (read/write, equivalent to using
  18.                   Attach/Detach methods).
  19.  
  20.                   Fixed bug in IsAttached.
  21.  
  22.                   Added BringToFront & SendToBack methods to correctly
  23.                   manipulate ChildControl
  24.  
  25.                   Added arrow keys to move a selected control in one-pixel
  26.                   increments.
  27.  
  28.                   Added a secondary color for selection of multiple Child
  29.                   controls.
  30.  
  31.                   Added logic to move siblings (other selected objects on
  32.                   the same Parent) when a selected object is moved.
  33.  
  34.                   Eliminated TOverlay mechanism for rubberbanding; now using
  35.                   WINAPI calls with GetDC(0).
  36.  
  37.                   Added a Lock property to disable move/resize.
  38.  
  39.                   Started adding a snap-to grid mechanism (GridX, GridY & SnapToGrid
  40.                   properties); needs more work, though.
  41.  
  42.   Anthony Scott
  43.   CIS: 75567,3547                                                           }
  44.  
  45. interface
  46.  
  47. uses
  48.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  49.   Forms, Menus, StdCtrls;
  50.                                        { miscellaneous type declarations }
  51. type
  52.   TDragStyle = (dsMove, dsSizeTopLeft, dsSizeTopRight, dsSizeBottomLeft, dsSizeBottomRight,
  53.                 dsSizeTop, dsSizeLeft, dsSizeBottom, dsSizeRight);
  54.   EBadChild = class(Exception);
  55.                                        { TStretchHandle component declaration }
  56. type
  57.   GridValues = 1..100;
  58.  
  59.   TStretchHandle = class(TCustomControl)
  60.   private
  61.     FDragOffset: TPoint;
  62.     FDragStyle: TDragStyle;
  63.     FDragging: boolean;
  64.     FDragRect: TRect;
  65.     FLocked: boolean;
  66.     FColor: TColor;
  67.     FPrimaryColor: TColor;
  68.     FSecondaryColor: TColor;
  69.     FGridX, FGridY: GridValues;
  70.     FChildControl: TControl;
  71.     procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
  72.     procedure WMGetDLGCode(var Message: TMessage); message WM_GETDLGCODE;
  73.     procedure SetChildControl(ChildControl: TControl);
  74.     procedure MoveSiblings(XOffset, YOffset: integer);
  75.     procedure Rubberband(NewRect: TRect);
  76.     function HasSiblings: boolean;
  77.     function GetChildControl: TControl;
  78.     function GetModifiedRect(XPos, YPos: integer): TRect;
  79.   protected
  80.     procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  81.     procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  82.     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  83.     procedure KeyDown(var key: Word; Shift: TShiftState); override;
  84.     procedure Paint; override;
  85.     property Canvas;
  86.   public
  87.     constructor Create(AOwner: TComponent); override;
  88.     destructor Destroy; override;
  89.     procedure CreateParams(var Params: TCreateParams); override;
  90.     procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
  91.     procedure BringToFront;
  92.     procedure SendToBack;
  93.     procedure Attach(ChildControl: TControl);
  94.     procedure Detach;
  95.     procedure SetColors(Color1, Color2: TColor);
  96.     procedure SwitchColor;
  97.     procedure SetGridState(Value: boolean);
  98.     function GetGridState: boolean;
  99.     function IsAttached: boolean;
  100.                                        { new run-time only properties }
  101.     property Child: TControl read GetChildControl write SetChildControl; 
  102.     property Attached: boolean read IsAttached;
  103.   published
  104.                                        { new properties }
  105.     property Color: TColor read FPrimaryColor write FPrimaryColor default clBlack;
  106.     property SecondaryColor: TColor read FSecondaryColor write FSecondaryColor default clGray;
  107.     property Locked: boolean read FLocked write FLocked default False;
  108.     property GridX: GridValues read FGridX write FGridX default 8;
  109.     property GridY: GridValues read FGridY write FGridY default 8;
  110.     property SnapToGrid: boolean read GetGridState write SetGridState default False;
  111.                                        { inherited properties }
  112.     property DragCursor;
  113.     property Enabled;
  114.     property Hint;
  115.     property ParentShowHint;
  116.     property PopupMenu;
  117.     property ShowHint;
  118.     property Visible;
  119.                                        { defined events }
  120.     property OnClick;
  121.     property OnDblClick;
  122.     property OnMouseDown;
  123.     property OnMouseMove;
  124.     property OnMouseUp;
  125.     property OnKeyDown;
  126.     property OnKeyPress;
  127.   end;
  128.  
  129. procedure Register;
  130.  
  131. implementation
  132.  
  133. procedure Register;
  134. begin
  135.                                        { add the component to the 'Samples' tab }
  136.   RegisterComponents('Samples', [TStretchHandle]);
  137.  
  138. end;
  139.  
  140. constructor TStretchHandle.Create(AOwner: TComponent);
  141. var
  142.   i: integer;
  143.   Found: boolean;
  144. begin
  145.  
  146.   inherited Create(AOwner);
  147.                                        { initialize default properties }
  148.   Width := 24;
  149.   Height := 24;
  150.   FChildControl := nil;
  151.   FPrimaryColor := clBlack;
  152.   FSecondaryColor := clGray;
  153.                                        { a value of 1 is used to turn off the snap-to grid }
  154.   FGridX := 1;
  155.   FGridY := 1;
  156.                                        { doesn't do anything until it is Attached to something else }
  157.   Enabled := False;
  158.   Visible := False;
  159.  
  160.   Found := False;
  161.  
  162. end;
  163.  
  164. destructor TStretchHandle.Destroy;
  165. begin
  166.  
  167.   inherited Destroy;
  168.  
  169. end;
  170.  
  171. procedure TStretchHandle.CreateParams(var Params: TCreateParams);
  172. begin
  173.                                        { set default Params values }
  174.   inherited CreateParams(Params);
  175.                                        { then add transparency }
  176.   Params.ExStyle := Params.ExStyle + WS_EX_TRANSPARENT;
  177.  
  178. end;
  179.  
  180. procedure TStretchHandle.Attach(ChildControl: TControl);
  181. var
  182.   i: integer;
  183. begin
  184.                                        { definitely not allowed! }
  185.   if ChildControl is TForm then
  186.     raise EBadChild.Create('Handles can not be attached to this component');
  187.                                        { auto-detach if still attached (bad dog!); also detaches if Child = nil }
  188.   if Attached then
  189.     Detach;
  190.  
  191.   if (ChildControl <> nil) then
  192.     begin
  193.                                        { allows StretchHandle to manage the child control's size & position }
  194.       FChildControl := ChildControl;
  195.                                        { honour the lineage }
  196.       Parent := ChildControl.Parent;
  197.       SetBounds(ChildControl.Left - 2, ChildControl.Top - 2, ChildControl.Width + 5, ChildControl.Height + 5);
  198.                                        { look for siblings, set up secondary colors if any found }
  199.       FColor := FPrimaryColor;
  200.       for i := 0 to Parent.ControlCount - 1 do
  201.         if Parent.Controls[i] is TStretchHandle then
  202.           begin
  203.             if (TStretchHandle(Parent.Controls[i]).Attached) and (TStretchHandle(Parent.Controls[i]) <> Self) then
  204.               begin
  205.                 FColor := FSecondaryColor;
  206.                 TStretchHandle(Parent.Controls[i]).SwitchColor;
  207.               end;
  208.           end;
  209.                                        { only make it visible now, to avoid color flashing, & accept events }
  210.       FDragRect := Rect(0, 0, 0, 0);
  211.       Enabled := True;
  212.       Visible := True;
  213.                                        { use old BringToFront so as not to change Child's Z-order }
  214.       if not (csDesigning in ComponentState) then
  215.         begin
  216.           inherited BringToFront;
  217.           SetFocus;
  218.         end;
  219.  
  220.     end;
  221.  
  222. end;
  223.  
  224. procedure TStretchHandle.Detach;
  225. begin
  226.                                        { disable & hide StretchHandle }
  227.   FChildControl := nil;
  228.   FLocked := False;
  229.   Enabled := False;
  230.   Visible := False;
  231.   Parent := nil;
  232.   FDragRect := Rect(0, 0, 0, 0);
  233.  
  234. end;
  235.  
  236. procedure TStretchHandle.SetColors(Color1, Color2: TColor);
  237. begin
  238.                                        { set single/multiple select colors }
  239.   FPrimaryColor := Color1;
  240.   FSecondaryColor := Color2;
  241.                                        { presume (in case it is already attached)... }
  242.   if HasSiblings then
  243.     FColor := FSecondaryColor
  244.   else
  245.     FColor := FPrimaryColor;
  246.  
  247. end;
  248.  
  249. procedure TStretchHandle.SwitchColor;
  250. begin
  251.                                        { set secondary color (may be invoked by siblings) }
  252.   FColor := FSecondaryColor;
  253.  
  254. end;
  255.  
  256. procedure TStretchHandle.SetChildControl(ChildControl: TControl);
  257. begin
  258.  
  259.   if (ChildControl <> nil) then
  260.     Attach(ChildControl)
  261.   else
  262.     Detach;
  263.                                        
  264. end;
  265.  
  266. function TStretchHandle.GetChildControl: TControl;
  267. begin
  268.  
  269.   Result := FChildControl;
  270.  
  271. end;
  272.  
  273. function TStretchHandle.HasSiblings: boolean;
  274. var
  275.   i: integer;
  276. begin
  277.                                        { find out if there is at least one sibling }
  278.   Result := False;
  279.   for i := 0 to Parent.ControlCount - 1 do
  280.     if (Parent.Controls[i] is TStretchHandle) and (TStretchHandle(Parent.Controls[i]) <> Self) then
  281.       begin
  282.         Result := True;
  283.         break;
  284.       end;
  285.  
  286. end;
  287.  
  288. procedure TStretchHandle.SetGridState(Value: boolean);
  289. begin
  290.                                        { a value of 1 effectively disables a grid axis }
  291.   if Value then
  292.     begin
  293.       FGridX := 8;
  294.       FGridY := 8;
  295.     end
  296.   else
  297.     begin
  298.       FGridX := 1;
  299.       FGridY := 1;
  300.     end;
  301.  
  302. end;
  303.  
  304. function TStretchHandle.GetGridState: boolean;
  305. begin
  306.  
  307.   if (FGridX > 1) or (FGridY > 1) then
  308.     Result := True
  309.   else
  310.     Result := False;
  311.  
  312. end;
  313.  
  314. function TStretchHandle.IsAttached: boolean;
  315. begin
  316.  
  317.   if FChildControl <> nil then
  318.     Result := True
  319.   else
  320.     Result := False;
  321.  
  322. end;
  323.  
  324. procedure TStretchHandle.WMGetDLGCode(var Message: TMessage);
  325. begin
  326.                                        { completely fake erase, don't call inherited, don't collect $200 }
  327.   Message.Result := DLGC_WANTARROWS;
  328.  
  329. end;
  330.  
  331. procedure TStretchHandle.WMEraseBkgnd(var Message: TWMEraseBkgnd);
  332. begin
  333.                                        { completely fake erase, don't call inherited, don't collect $200 }
  334.   Message.Result := 1;
  335.  
  336. end;
  337.  
  338. procedure TStretchHandle.MouseMove(Shift: TShiftState; X, Y: Integer);
  339. var
  340.   ARect, BRect: TRect;
  341.   DragStyle: TDragStyle;
  342. begin
  343.                                        { default to move cursor unless near a drag box }
  344.   DragStyle := dsMove;
  345.   Cursor := DragCursor;
  346.                                        { disallow resize if siblings present }
  347.   if not HasSiblings then
  348.     begin
  349.  
  350.       ARect := GetClientRect;
  351.                                        { so I don't like long nested if statements... }
  352.       if ((Abs(X - ARect.Left) < 5) and (Abs(Y - ARect.Top) < 5)) then
  353.         begin
  354.           DragStyle := dsSizeTopLeft;
  355.           Cursor := crSizeNWSE;
  356.         end;
  357.  
  358.       if ((Abs(X - ARect.Right) < 5) and (Abs(Y - ARect.Bottom) < 5)) then
  359.         begin
  360.           DragStyle := dsSizeBottomRight;
  361.           Cursor := crSizeNWSE;
  362.         end;
  363.  
  364.       if ((Abs(X - ARect.Right) < 5) and (Abs(Y - ARect.Top) < 5)) then
  365.         begin
  366.           DragStyle := dsSizeTopRight;
  367.           Cursor := crSizeNESW;
  368.         end;
  369.  
  370.       if ((Abs(X - ARect.Left) < 5) and (Abs(Y - ARect.Bottom) < 5)) then
  371.         begin
  372.           DragStyle := dsSizeBottomLeft;
  373.           Cursor := crSizeNESW;
  374.         end;
  375.  
  376.       if ((Abs(X - trunc(ARect.Right - ARect.Left) / 2) < 3) and (Abs(Y - ARect.Top) < 5)) then
  377.         begin
  378.           DragStyle := dsSizeTop;
  379.           Cursor := crSizeNS;
  380.         end;
  381.  
  382.       if ((Abs(X - trunc(ARect.Right - ARect.Left) / 2) < 3) and (Abs(Y - ARect.Bottom) < 5)) then
  383.         begin
  384.           DragStyle := dsSizeBottom;
  385.           Cursor := crSizeNS;
  386.         end;
  387.  
  388.       if ((Abs(Y - trunc(ARect.Bottom - ARect.Top) / 2) < 3) and (Abs(X - ARect.Left) < 5)) then
  389.         begin
  390.           DragStyle := dsSizeLeft;
  391.           Cursor := crSizeWE;
  392.         end;
  393.  
  394.       if ((Abs(Y - trunc(ARect.Bottom - ARect.Top) / 2) < 3) and (Abs(X - ARect.Right) < 5)) then
  395.         begin
  396.           DragStyle := dsSizeRight;
  397.           Cursor := crSizeWE;
  398.         end;
  399.  
  400.     end;
  401.  
  402.   if FDragging then
  403.     begin
  404.                                        { adjust for snap-to grid (with offset for Child's position) }
  405.       if FGridX > 1 then
  406.         X := (X DIV FGridX) * FGridX - 2;
  407.       if FGridY > 1 then
  408.         Y := (Y DIV FGridY) * FGridY - 2;
  409.                                        { disallow drag off Parent }
  410.       if (Left + X) < 0 then
  411.         X := -Left;
  412.       if (Top + Y) < 0 then
  413.         Y := -Top;
  414.       if (Left + X) > Parent.Width then
  415.         X := Parent.Width - Left;
  416.       if (Top + Y) > Parent.Height then
  417.         Y := Parent.Height - Top;
  418.                                        { display drag outline }
  419.       RubberBand(GetModifiedRect(X, Y));
  420.     end
  421.   else
  422.     FDragStyle := DragStyle;
  423.                                        { if position-locked, override cursor change }
  424.   if FLocked then
  425.     Cursor := crNoDrop;
  426.                                        { perform default processing }
  427.   inherited MouseMove(Shift, X, Y);
  428.  
  429. end;
  430.  
  431. procedure TStretchHandle.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  432. begin
  433.  
  434.   if (Button = mbLeft) and not FLocked then
  435.     begin
  436.                                        { adjust for snap-to grid (with offset for Child's position) }
  437.       if FGridX > 1 then
  438.         X := (X DIV FGridX) * FGridX - 2;
  439.       if FGridY > 1 then
  440.         Y := (Y DIV FGridY) * FGridY - 2;
  441.                                        { save position relative to Canvas, & which corner/side to drag }
  442.       FDragOffset := Point(X, Y);
  443.       FDragging := True;
  444.       RubberBand(GetModifiedRect(X, Y));
  445.  
  446.     end;
  447.                                        { perform default processing }
  448.   inherited MouseDown(Button, Shift, X, Y);
  449.  
  450. end;
  451.  
  452. procedure TStretchHandle.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  453. var
  454.   ARect: TRect;
  455. begin
  456.  
  457.   if Button = mbLeft then
  458.     begin
  459.                                        { adjust for snap-to grid (with offset for Child's position) }
  460.       if FGridX > 1 then
  461.         X := (X DIV FGridX) * FGridX - 2;
  462.       if FGridY > 1 then
  463.         Y := (Y DIV FGridY) * FGridY - 2;
  464.                                        { disallow drop off Parent }
  465.       if (Left + X) < 0 then
  466.         X := -Left;
  467.       if (Top + Y) < 0 then
  468.         Y := -Top;
  469.       if (Left + X) > Parent.Width then
  470.         X := Parent.Width - Left;
  471.       if (Top + Y) > Parent.Height then
  472.         Y := Parent.Height - Top;
  473.  
  474.       if FDragging then
  475.         begin
  476.                                        { obtain new coordinates }
  477.           ARect := GetModifiedRect(X, Y);
  478.           RubberBand(Rect(0, 0, 0, 0));
  479.                                        { force Paint when size doesn't change but position does }
  480.           if (ARect.Left <> Left) or (ARect.Top <> Top) then
  481.             Invalidate;
  482.                                        { if this was a move, first move siblings }
  483.           if FDragStyle = dsMove then
  484.             MoveSiblings(ARect.Left - Left, ARect.Top - Top);
  485.                                        { resize, reposition if anything changed }
  486.           SetBounds(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
  487.  
  488.           FDragging := False;
  489.                                        { seem to need this for keyboard events }
  490.           SetFocus;
  491.  
  492.         end;
  493.  
  494.         ReleaseCapture;
  495.  
  496.     end;
  497.                                        { perform default processing }
  498.   inherited MouseUp(Button, Shift, X, Y);
  499.  
  500. end;
  501.  
  502. procedure TStretchHandle.KeyDown(var Key: Word; Shift: TShiftState);
  503. begin
  504.                                        { process arrow keys to move/resize Handles & Child, also move siblings }
  505.   case Key of
  506.     VK_UP:
  507.       begin
  508.         if FChildControl <> nil then
  509.           FChildControl.Invalidate;
  510.         Invalidate;
  511.         SetBounds(Left, Top - 1, Width, Height);
  512.         MoveSiblings(0, -1);
  513.       end;
  514.     VK_DOWN:
  515.       begin
  516.         if FChildControl <> nil then
  517.           FChildControl.Invalidate;
  518.         Invalidate;
  519.         SetBounds(Left, Top + 1, Width, Height);
  520.         MoveSiblings(0, 1);
  521.       end;
  522.     VK_LEFT:
  523.       begin
  524.         if FChildControl <> nil then
  525.           FChildControl.Invalidate;
  526.         Invalidate;
  527.         SetBounds(Left - 1, Top, Width, Height);
  528.         MoveSiblings(-1, 0);
  529.       end;
  530.     VK_RIGHT:
  531.       begin
  532.         if FChildControl <> nil then
  533.           FChildControl.Invalidate;
  534.         Invalidate;
  535.         SetBounds(Left + 1, Top, Width, Height);
  536.         MoveSiblings(1, 0);
  537.       end;
  538.   end;
  539.  
  540.   inherited KeyDown(Key, Shift);
  541.  
  542. end;
  543.  
  544. function TStretchHandle.GetModifiedRect(XPos, YPos: integer): TRect;
  545. var
  546.   ARect: TRect;
  547. begin
  548.                                        { compute new position/size, depending on FDragStyle}
  549.   case FDragStyle of
  550.  
  551.     dsSizeTopLeft:
  552.       begin
  553.         ARect.Left := Left + (XPos - FDragOffset.X);
  554.         ARect.Top := Top + (YPos - FDragOffset.Y);
  555.         ARect.Right := Width - (ARect.Left - Left);
  556.         ARect.Bottom := Height - (ARect.Top - Top);
  557.       end;
  558.  
  559.     dsSizeTopRight:
  560.       begin
  561.         ARect.Left := Left;
  562.         ARect.Top := Top + (YPos - FDragOffset.Y);
  563.         ARect.Right := Width + (XPos - FDragOffset.X);
  564.         ARect.Bottom := Height - (ARect.Top - Top);
  565.       end;
  566.  
  567.     dsSizeBottomLeft:
  568.       begin
  569.         ARect.Left := Left + (XPos - FDragOffset.X);
  570.         ARect.Top := Top;
  571.         ARect.Right := Width - (ARect.Left - Left);
  572.         ARect.Bottom := Height + (YPos - FDragOffset.Y);
  573.       end;
  574.  
  575.     dsSizeBottomRight:
  576.       begin
  577.         ARect.Left := Left;
  578.         ARect.Top := Top;
  579.         ARect.Right := Width + (XPos - FDragOffset.X);
  580.         ARect.Bottom := Height + (YPos - FDragOffset.Y);
  581.       end;
  582.  
  583.     dsSizeTop:
  584.       begin
  585.         ARect.Left := Left;
  586.         ARect.Top := Top + (YPos - FDragOffset.Y);
  587.         ARect.Right := Width;
  588.         ARect.Bottom := Height - (ARect.Top - Top);
  589.       end;
  590.  
  591.     dsSizeBottom:
  592.       begin
  593.         ARect.Left := Left;
  594.         ARect.Top := Top;
  595.         ARect.Right := Width;
  596.         ARect.Bottom := Height + (YPos - FDragOffset.Y);
  597.       end;
  598.  
  599.     dsSizeLeft:
  600.       begin
  601.         ARect.Left := Left + (XPos - FDragOffset.X);
  602.         ARect.Top := Top;
  603.         ARect.Right := Width - (ARect.Left - Left);
  604.         ARect.Bottom := Height;
  605.       end;
  606.  
  607.     dsSizeRight:
  608.       begin
  609.         ARect.Left := Left;
  610.         ARect.Top := Top;
  611.         ARect.Right := Width + (XPos - FDragOffset.X);
  612.         ARect.Bottom := Height;
  613.       end;
  614.  
  615.   else
  616.                                        { keep size, move to new position }
  617.     ARect.Left := Left + (XPos - FDragOffset.X);
  618.     ARect.Top := Top + (YPos - FDragOffset.Y);
  619.     ARect.Right := Width;
  620.     ARect.Bottom := Height;
  621.  
  622.   end;
  623.                                        { impose a minimum size for sanity }
  624.   if ARect.Right < 5 then
  625.     ARect.Right := 5;
  626.   if ARect.Bottom < 5 then
  627.     ARect.Bottom := 5;
  628.  
  629.   Result := ARect;
  630.  
  631. end;
  632.  
  633. procedure TStretchHandle.Rubberband(NewRect: TRect);
  634. var
  635.   PtA, PtB: TPoint;
  636.   ScreenDC: HDC;
  637. begin
  638.  
  639.   ScreenDC := GetDC(0);
  640.                                        { erase previous rectangle, if any, & adjust for handle's position }
  641.   PtA := Parent.ClientToScreen(Point(FDragRect.Left + 2, FDragRect.Top + 2));
  642.   PtB := Parent.ClientToScreen(Point(FDragRect.Left + FDragRect.Right - 3, FDragRect.Top + FDragRect.Bottom - 3));
  643.   if (FDragRect.Left <> 0) or (FDragRect.Top <> 0) or (FDragRect.Right <> 0) or (FDragRect.Bottom <> 0) then
  644.     DrawFocusRect(ScreenDC, Rect(PtA.X, PtA.Y, PtB.X, PtB.Y));
  645.                                        { draw new rectangle }
  646.   PtA := Parent.ClientToScreen(Point(NewRect.Left + 2, NewRect.Top + 2));
  647.   PtB := Parent.ClientToScreen(Point(NewRect.Left + NewRect.Right - 3, NewRect.Top + NewRect.Bottom - 3));
  648.   if (NewRect.Left <> 0) or (NewRect.Top <> 0) or (NewRect.Right <> 0) or (NewRect.Bottom <> 0) then
  649.     DrawFocusRect(ScreenDC, Rect(PtA.X, PtA.Y, PtB.X, PtB.Y));
  650.  
  651.   FDragRect := NewRect;
  652.  
  653.   ReleaseDC(0, ScreenDC);
  654.  
  655. end;
  656.  
  657. procedure TStretchHandle.BringToFront;
  658. begin
  659.                                        { take care of Child first }
  660.   if FChildControl <> nil then
  661.     FChildControl.BringToFront;
  662.   inherited BringToFront;
  663.   SetFocus;
  664.  
  665. end;
  666.  
  667. procedure TStretchHandle.SendToBack;
  668. begin
  669.                                        { only child goes to back! }
  670.   if FChildControl <> nil then
  671.     FChildControl.SendToBack;
  672.   inherited BringToFront;
  673.   SetFocus;
  674.  
  675. end;
  676.  
  677. procedure TStretchHandle.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
  678. var
  679.    WasVisible: boolean;
  680. begin
  681.                                        { hide & preserve fixed size in design mode }
  682.   WasVisible := Visible;
  683.   if csDesigning in ComponentState then
  684.     begin
  685.       Visible := False;
  686.       inherited SetBounds(ALeft, ATop, 24, 24);
  687.     end
  688.   else                                 { move child also, if any (but only if not locked) }
  689.     if not FLocked then
  690.       begin
  691.         if FChildControl <> nil then
  692.           FChildControl.SetBounds(ALeft + 2, ATop + 2, AWidth - 5, AHeight - 5);
  693.         inherited SetBounds(ALeft, ATop, AWidth, AHeight);
  694.       end;
  695.                                        { restore visibility }
  696.   if Visible = False then
  697.     Visible := WasVisible;
  698.  
  699. end;
  700.  
  701. procedure TStretchHandle.MoveSiblings(XOffset, YOffset: integer);
  702. var
  703.   i, T, L, W, H: integer;
  704. begin
  705.                                        { look for siblings, adjust their position by FDropOffset }
  706.   for i := 0 to Parent.ControlCount - 1 do
  707.     if Parent.Controls[i] is TStretchHandle then
  708.       begin
  709.         if (TStretchHandle(Parent.Controls[i]).Attached) and (TStretchHandle(Parent.Controls[i]) <> Self) then
  710.           begin
  711.             L := TStretchHandle(Parent.Controls[i]).Left + XOffset;
  712.             T := TStretchHandle(Parent.Controls[i]).Top + YOffset;
  713.             W := TStretchHandle(Parent.Controls[i]).Width;
  714.             H := TStretchHandle(Parent.Controls[i]).Height;
  715.             TStretchHandle(Parent.Controls[i]).Invalidate;
  716.             TStretchHandle(Parent.Controls[i]).SetBounds(L, T, W, H);
  717.           end;
  718.       end;
  719.  
  720. end;
  721.  
  722. procedure TStretchHandle.Paint;
  723. var
  724.    ARect, BoxRect: TRect;
  725. begin
  726.  
  727.   inherited Paint;
  728.  
  729.   ARect := Rect(0, 0, Width - 1, Height - 1);
  730.  
  731.   with Canvas do
  732.     begin
  733.  
  734.       Brush.Color := FColor;
  735.                                        { draw corner boxes (assuming Canvas is minimum 5x5) }
  736.       BoxRect := Rect(ARect.Left, ARect.Top, ARect.Left + 5, ARect.Top + 5);
  737.       FillRect(BoxRect);
  738.       BoxRect := Rect(ARect.Right - 5, ARect.Top, ARect.Right, ARect.Top + 5);
  739.       FillRect(BoxRect);
  740.       BoxRect := Rect(ARect.Right - 5, ARect.Bottom - 5, ARect.Right, ARect.Bottom);
  741.       FillRect(BoxRect);
  742.       BoxRect := Rect(ARect.Left, ARect.Bottom - 5, ARect.Left + 5, ARect.Bottom);
  743.       FillRect(BoxRect);
  744.                                        { draw center boxes (favouring 1 pixel to the right for even sides) }
  745.       BoxRect := Rect(trunc((ARect.Right - ARect.Left) / 2) - 2,
  746.                       ARect.Top,
  747.                       trunc((ARect.Right - ARect.Left) / 2) + 3,
  748.                       ARect.Top + 5);
  749.       FillRect(BoxRect);
  750.       BoxRect := Rect(trunc((ARect.Right - ARect.Left) / 2) - 2,
  751.                       ARect.Bottom - 5,
  752.                       trunc((ARect.Right - ARect.Left) / 2) + 3,
  753.                       ARect.Bottom);
  754.       FillRect(BoxRect);
  755.       BoxRect := Rect(ARect.Left,
  756.                       trunc((ARect.Bottom - ARect.Top) / 2) - 2,
  757.                       ARect.Left + 5,
  758.                       trunc((ARect.Bottom - ARect.Top) / 2) + 3);
  759.       FillRect(BoxRect);
  760.       BoxRect := Rect(ARect.Right - 5,
  761.                       trunc((ARect.Bottom - ARect.Top) / 2) - 2,
  762.                       ARect.Right,
  763.                       trunc((ARect.Bottom - ARect.Top) / 2) + 3);
  764.       FillRect(BoxRect);
  765.  
  766.     end;
  767.  
  768. end;
  769.  
  770. end.
  771.